home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 4 / Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso / Pearls / dev / Oberon / OberonV4 / system / Amiga.Mod (.txt) next >
Oberon Text  |  1996-05-27  |  32KB  |  908 lines
  1. Syntax20b.Scn.Fnt
  2. ParcElems
  3. Alloc
  4. Syntax24b.Scn.Fnt
  5. Syntax10.Scn.Fnt
  6. Syntax10b.Scn.Fnt
  7. Syntax10i.Scn.Fnt
  8. FoldElems
  9. Syntax16.Scn.Fnt
  10. Syntax12.Scn.Fnt
  11. (* AMIGA *)
  12. MODULE Amiga;
  13.     Data types, constants, variables, and procedures used to interface
  14.     to the Amiga OS, and to link various high-level modules together.
  15. IMPORT
  16.     SYSTEM,  A:=AmigaAsl, D:=AmigaDos, E:=AmigaExec, G:=AmigaGraphics,
  17.     I:=AmigaIntuition, U:=AmigaUtility, T:=AmigaTimer;
  18. CONST
  19.         These default values are used, if no Oberon4Amiga environment
  20.         variable was found.
  21.     defaultHeight =800;
  22.     defaultWidth = 1024;
  23.     defaultDepth = 4;
  24.     maxDepth = 8;
  25.         The name of the environment variable used. envarcName is
  26.         used for pre V39 AmigaOS, where the copy in the ENVARC:
  27.         directory is not made automatically by SetEnv.
  28.     envName = "Oberon4Amiga";
  29.     envarcName = "ENVARC:Oberon4Amiga";
  30.         The first value of the environment variable contains a version
  31.         field. This is the current version.
  32.     infoVersion = 6;
  33.     pointerSize = 16*4;
  34.         The title of the screen, and also the copyright notice appearing
  35.         in the Log on system startup.
  36.     screenTitle = "Oberon System V4 for Amiga V1.3";
  37.     TrapErr* = 0; ExceptionErr* = 1; SystemErr* = 2;    (** values for ErrorFrame.type *)
  38.         The sizes for the ChipMemPool
  39.      PoolPuddleSize = 32768; PoolThreshSize = PoolPuddleSize DIV 2;
  40.     Absolute=LONGINT;
  41.     Module=LONGINT;
  42.     NewProc*=PROCEDURE(tag:LONGINT):LONGINT;
  43.         The content of the environment varibale. Currently it is
  44.         stored binary, as is. All but the version field contain values
  45.         needed for opening the initial screen.
  46.     Info=RECORD
  47.         version:LONGINT;
  48.         displayID:LONGINT;
  49.         height:INTEGER;
  50.         width:INTEGER;
  51.         depth:INTEGER;
  52.         oscan:LONGINT;
  53.         autoScroll:BOOLEAN;
  54.         useWBWindow: BOOLEAN;
  55.         modifyColors: BOOLEAN
  56.     END;
  57.         Real pointers declarations. The Amiga* modules only
  58.         export these pointer types as LONGINT, to avoid
  59.         problems with the garbage collection.
  60.     ProcessPtr=POINTER TO D.Process;
  61.     ScreenPtr=POINTER TO I.Screen;
  62.     WindowPtr=POINTER TO I.Window;
  63.     BitmapPtr=POINTER TO G.BitMap;
  64.     RPPtr=POINTER TO G.RastPort;
  65.     IOExtTimerPtr = POINTER TO T.TimeRequest;
  66.         This is the Amiga specific way to store an Oberon
  67.         pattern.
  68.     PatternInfoPtr*= POINTER TO PatternInfo;
  69.     PatternInfo*= RECORD
  70.         modulo*: INTEGER;
  71.         w*, h*: SHORTINT;
  72.         data*: LONGINT; (* Pointer to individual pattern in chip mem. This pointer is used for patterns and Oberon fonts. *)
  73.         offset*: INTEGER; (* Offset to individual pattern in chip mem. This offset is used for Amiga fonts. *)
  74.     END;
  75.         characters are patterns with additional informations needed by the
  76.         Display.GetChar routine. They are not part of Patterns, because they are
  77.         of now use as soon, as the character was "transformed" into a
  78.         simple pattern by Display.GetChar.
  79.     CharInfo*=RECORD (PatternInfo) (* Font related character info *)
  80.         dx*, x*, y*: SHORTINT
  81.     END;
  82.         This is the Amiga specific representation of a font. Data and size point
  83.         to a contiguos memory block which contains all character data (as they
  84.         are build by the diskfont.library).
  85.     Font*= POINTER TO FontInfo;
  86.     FontInfo*= RECORD
  87.         data*: LONGINT; (* Pointer to character data block in chip mem. *)
  88.         size*: LONGINT; (* size of data block *)
  89.         info*: ARRAY 256 OF CharInfo;
  90.         amigaFont*: G.TextFontPtr;
  91.     END;
  92.         This contains the information needed as starting point to
  93.         build a trap viewer.
  94.     ErrorFrame*= RECORD
  95.         PC-: LONGINT;    (** PC value *)
  96.         SP-: LONGINT;    (** Stack Pointer *)
  97.         FP-: LONGINT;    (** Frame Pointer *)
  98.         type-: LONGINT;    (** type of error: TrapErr, ExceptionErr, SystemErr, 3 = Assertion, 4 = BreakPoint, 5 = Explicit *)
  99.         val-: LONGINT    (** type = TrapErr => trap number; type = ExceptionErr => exception mask (SET) *)
  100.     END;
  101.         Through this procedure variables, the routines from OLoad are called.
  102.         For this to work, OLoad will patch in the address of a procedure into
  103.         this variable. This can obviously work only, if the offset in memory
  104.         of this variable is known.
  105.         Therefore it is VERY IMPORTANT, that these variables remains the first
  106.         declared variables in the module, and thus start at offset -4.
  107.         The two guard variables are filled with some predefined values by OLoad
  108.         so that on module initialisation it can be verifyed, if the variables have
  109.         moved in respect to what OLoad expects .
  110.     guard1:LONGINT;
  111.     loaderCall:PROCEDURE();
  112.     guard2:LONGINT;
  113.         These variables export the window and rast port which have to be used
  114.         for the Oberon screen, as well as their dimensions.
  115.     Depth-, OberonDepth-, ColorOffset-: INTEGER;
  116.     Height-:INTEGER;
  117.     Width-:INTEGER;
  118.     window-: I.WindowPtr;
  119.     WBWindow-: BOOLEAN;
  120.     ModifyColors-: BOOLEAN;
  121.     PensObtained: BOOLEAN;
  122.         The next two variables allow the customization of two Amiga specific
  123.         behaviours.
  124.         dontConvert inhibits the conversion of ISO-Latin1-Input to the Oberon
  125.         character set convention. This is needed, if an Latin1 document has to be
  126.         edited. This variable is initialised to FALSE.
  127.         useLAltAsMouse enables the usage of the left alt key as a replacement
  128.         for a middle mouse button, when only a two button mouse is available.
  129.         This variable is initialised to TRUE.
  130.     dontConvert*:BOOLEAN;
  131.     useLAltAsMouse*:BOOLEAN;
  132.         This varible is initialised to the screen title. A read only variable is
  133.         exported instead of the screenTitle constant, to avoid the generation
  134.         of a new symbol file just because the string content has changed.
  135.     version-:ARRAY 64 OF CHAR;
  136.     idlePri*:SHORTINT;
  137.     normalPri*:SHORTINT;
  138.         This is the stack pointer to which the trap handler has to
  139.         return. It is remembered in Amiga.Loop and used in ???.
  140.     stackPtr-: LONGINT;
  141.         thinks for the Timer Device
  142.     TimerOpen*: BOOLEAN;
  143.     TimerMP: E.MsgPortPtr;
  144.     TimerIOPtr: E.MessagePtr;
  145.     TicsToWait*: LONGINT;
  146.         Name of the current printer. Will be send to the OberonPrint script
  147.     PrinterName*: ARRAY 64 OF CHAR;
  148.         Threshold for the Color of Pictures to be printed as white, 0<=n<=256
  149.     PictPrintThresh*: INTEGER;
  150.         Define the Type of the Main Loop
  151.     MainLoopType*: BOOLEAN;
  152.         Pointer to Chip-Memory-Pool (used only if exeVersion>=39
  153.     ChipMemPool-: E.MemPoolPtr;
  154.         Flag for the Requester of System.Quit
  155.     UseQuitRequester*: BOOLEAN;
  156.         Arrays for Character Conversion Amiga <-> Oberon
  157.     AtoO, OtoA: ARRAY 256 OF CHAR;
  158.         ???
  159.     oldProcessWindow:I.WindowPtr;
  160.     screen:I.ScreenPtr;
  161.     pointerData:LONGINT;
  162.     Procedures of OLoad are called with register D3 containing the
  163.     address of a variable of type CallData. The first long word of CallData
  164.     contains a function code. The following  long words contain
  165.     parameters as requested by the specific function. Addresses are
  166.     passed whenever a VAR parameter is requested.
  167.     CallData=ARRAY 8 OF LONGINT;
  168. (* Close Timer Device *)
  169. PROCEDURE CloseTimerDevice;
  170. BEGIN
  171.     IF TimerOpen THEN
  172.         E.CloseDevice(TimerIOPtr)
  173.     END;
  174.     IF TimerIOPtr#0 THEN
  175.         E.DeleteIORequest(TimerIOPtr)
  176.     END;
  177.     IF TimerMP#0 THEN
  178.         E.DeleteMsgPort(TimerMP)
  179.     END;
  180.     TimerOpen:=FALSE; TimerMP:=0; TimerIOPtr:=0
  181. END CloseTimerDevice;
  182. (* Open Timer Device *)
  183. PROCEDURE OpenTimerDevice;
  184. BEGIN
  185.     IF ~TimerOpen THEN
  186.         TimerMP:=E.CreateMsgPort();
  187.         IF TimerMP#0 THEN
  188.             TimerIOPtr:=E.CreateIORequest(TimerMP, SIZE(T.TimeRequest));
  189.             IF TimerIOPtr#0 THEN
  190.                 IF E.OpenDevice(T.timerName, T.microHz, TimerIOPtr, {})=0 THEN TimerOpen:=TRUE END
  191.             END
  192.         END;
  193.         IF ~TimerOpen THEN CloseTimerDevice() END
  194. END OpenTimerDevice;
  195. (* Wait sec and micro/1000000 seconds using Timer Device *)
  196. PROCEDURE WaitTime*(sec, micro: LONGINT);
  197.         TimerIO: IOExtTimerPtr;
  198.         r: SHORTINT;
  199. BEGIN
  200.     TimerIO:=SYSTEM.VAL(IOExtTimerPtr, TimerIOPtr);
  201.     TimerIO.command:=T.addRequest;
  202.     TimerIO.time.secs:=sec;
  203.     TimerIO.time.micro:=micro;
  204.     r:=E.DoIO(TimerIOPtr)
  205. END WaitTime;
  206. PROCEDURE -SaveRegs 048H,0E7H,0FFH,0FEH,02AH,04EH;
  207. (* MOVEM D0-D7/A0-A6,-(A7) MOVEA.L A6,A5 *)
  208. PROCEDURE -LoadRegs 04CH,0DFH,07FH,0FFH;
  209. (* MOVEM.L (A7)+,D0-D7/A0-A6 *)
  210. PROCEDURE CallModula(VAR data:CallData);
  211. BEGIN
  212.     SaveRegs;
  213.     SYSTEM.PUTREG(3,SYSTEM.ADR(data));
  214.     loaderCall(); (* The code for this is in OLoad. *)
  215.     LoadRegs
  216. END CallModula;
  217. PROCEDURE Allocate*(VAR adr:LONGINT; size:LONGINT);
  218.     Allocates an Amiga OS memory block. Used by Kernel and Fonts.
  219.     cd:CallData;
  220. BEGIN
  221.     cd[0]:=7;
  222.     cd[1]:=SYSTEM.ADR(adr);
  223.     cd[2]:=size;
  224.     CallModula(cd)
  225. END Allocate;
  226. PROCEDURE Assert*(cond:BOOLEAN; msg:ARRAY OF CHAR);
  227.     Perform an Arts.Assert.
  228.     cd:CallData;
  229. BEGIN
  230.     cd[0]:=10;
  231.     IF cond THEN cd[1]:=1 ELSE cd[1]:=0 END;
  232.     cd[2]:=SYSTEM.ADR(msg);
  233.     CallModula(cd)
  234. END Assert;
  235. PROCEDURE Deallocate*(adr:LONGINT; size:LONGINT);
  236.     Deallocates an Amiga OS memory block. Used by Kernel and Fonts.
  237.     cd:CallData;
  238. BEGIN
  239.     cd[0]:=12;
  240.     cd[1]:=adr;
  241.     cd[2]:=size;
  242.     CallModula(cd)
  243. END Deallocate;
  244. PROCEDURE GetSearchPath*(VAR searchPath: ARRAY OF CHAR);
  245.     Returns the search path which the loader received as
  246.     parameter.
  247.     cd:CallData;
  248. BEGIN
  249.     cd[0]:=17;
  250.     cd[1]:=SYSTEM.ADR(searchPath);
  251.     cd[2]:=LEN(searchPath);
  252.     CallModula(cd)
  253. END GetSearchPath;
  254. PROCEDURE ThisMod*(name:ARRAY OF CHAR; VAR module:Module; VAR res:INTEGER; VAR modules:Module; VAR imported:ARRAY OF CHAR);
  255.     With this routine, Modules.ThisMod accesses the loaders ThisMod
  256.     instead of reimplementing it.
  257.     cd:CallData;
  258. BEGIN
  259.     cd[0]:=4;
  260.     cd[1]:=SYSTEM.ADR(name);
  261.     cd[2]:=SYSTEM.ADR(module);
  262.     cd[3]:=SYSTEM.ADR(res);
  263.     cd[4]:=SYSTEM.ADR(modules);
  264.     cd[5]:=SYSTEM.ADR(imported);
  265.     CallModula(cd)
  266. END ThisMod;
  267. PROCEDURE ThisCommand*(mod:Module; cmdname:ARRAY OF CHAR; VAR adr:Absolute; VAR res:INTEGER);
  268.     With this routine, Modules.ThisCommand accesses the loaders ThisCommand
  269.     instead of reimplementing it.
  270.     cd:CallData;
  271. BEGIN
  272.     cd[0]:=5;
  273.     cd[1]:=mod;
  274.     cd[2]:=SYSTEM.ADR(cmdname);
  275.     cd[3]:=SYSTEM.ADR(adr);
  276.     cd[4]:=SYSTEM.ADR(res);
  277.     CallModula(cd)
  278. END ThisCommand;
  279. PROCEDURE Free*(name:ARRAY OF CHAR; all:BOOLEAN; VAR res:INTEGER; VAR modules:Module);
  280.     With this routine, Modules.Free accesses the loaders Free
  281.     instead of reimplementing it.
  282.     cd:CallData;
  283. BEGIN
  284.     cd[0]:=6;
  285.     cd[1]:=SYSTEM.ADR(name);
  286.     IF all THEN cd[2]:=1 ELSE cd[2]:=0 END;
  287.     cd[3]:=SYSTEM.ADR(res);
  288.     cd[4]:=SYSTEM.ADR(modules);
  289.     CallModula(cd)
  290. END Free;
  291. PROCEDURE Terminate*();
  292.     Calls Arts.Terminate to bringdown Oberon. Show Requester bevor quitting, if Amiga.UseQuitRequester is TRUE.
  293.     cd:CallData;
  294. BEGIN
  295.     IF ~WBWindow THEN I.ClearPointer(window) END;
  296.     IF (~UseQuitRequester) OR
  297.     (I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga", "Do you really want to quit ?","Yes|No")#0) THEN
  298.         cd[0]:=3;
  299.         CallModula(cd)
  300.     END;
  301.     IF ~WBWindow THEN I.SetPointer(window,pointerData,2,16,0,0) END;
  302. END Terminate;
  303. PROCEDURE InstallNew*(proc:NewProc);
  304.     Passes the address of Kernel.SysNew to OLoad, so that
  305.     it can use it to fixx all NEW references.
  306.     cd:CallData;
  307. BEGIN
  308.     cd[0]:=0;
  309.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  310.     CallModula(cd)
  311. END InstallNew;
  312. PROCEDURE InstallSysNew*(proc:NewProc);
  313.     Passes the address of Kernel.SysNew to OLoad, so that
  314.     it can use it to fixx all SYSTEM.NEW references.
  315.     cd:CallData;
  316. BEGIN
  317.     cd[0]:=1;
  318.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  319.     CallModula(cd)
  320. END InstallSysNew;
  321. PROCEDURE InstallModuleList*(modList:LONGINT);
  322.     Passes the address of Kernel.module to OLoad, so that
  323.     it can update it, whenever it is needed (ThisMod/Free).
  324.     cd:CallData;
  325. BEGIN
  326.     cd[0]:=13;
  327.     cd[1]:=modList;
  328.     CallModula(cd)
  329. END InstallModuleList;
  330. PROCEDURE TermProcedure*(proc:PROCEDURE);
  331.     Passes the address of Kernel.FinalizeAll to OLoad, so that
  332.     it can call it on termination.
  333.     cd:CallData;
  334. BEGIN
  335.     cd[0]:=8;
  336.     cd[1]:=SYSTEM.VAL(LONGINT,proc);
  337.     CallModula(cd)
  338. END TermProcedure;
  339. PROCEDURE InstallTrapHandler*(p: PROCEDURE);
  340.     Installs trap handler in Arts.TrapStub
  341.     cd:CallData;
  342. BEGIN
  343.     cd[0]:=14;
  344.     cd[1]:=SYSTEM.VAL(LONGINT,p);
  345.     CallModula(cd)
  346. END InstallTrapHandler;
  347. PROCEDURE RestoreTrapHandler*;
  348.     restores old trap handler in Arts.TrapStub
  349.     cd:CallData;
  350. BEGIN
  351.     cd[0]:=15;
  352.     CallModula(cd)
  353. END RestoreTrapHandler;
  354. PROCEDURE GetErrorFrame*(VAR err: ErrorFrame);
  355.     gets trap information from Arts.errorFrame
  356.     cd:CallData;
  357. BEGIN
  358.     cd[0]:=16;
  359.     cd[1]:=SYSTEM.ADR(err);
  360.     CallModula(cd)
  361. END GetErrorFrame;
  362. PROCEDURE SystemHere*;
  363.     Tells loader, that system has come up to the point, that
  364.     it can display itself any error messages.
  365.     cd:CallData;
  366. BEGIN
  367.     cd[0]:=18;
  368.     CallModula(cd)
  369. END SystemHere;
  370. PROCEDURE Turbo*;
  371.     Set task priority high. Used before starting a command.
  372. VAR task: E.TaskPtr; dummy: LONGINT;
  373. BEGIN
  374.     task := E.FindTask(0);
  375.     dummy := E.SetTaskPri(task, normalPri)
  376. END Turbo;
  377. PROCEDURE Idle*;
  378.     Set task priority low. Used after a command finishes and Oberon.Loop resumes.
  379. VAR task: E.TaskPtr; dummy: LONGINT;
  380. BEGIN
  381.     task := E.FindTask(0);
  382.     dummy := E.SetTaskPri(task, idlePri)
  383. END Idle;
  384. PROCEDURE Close*;
  385.     Free the custom (= blank) pointer sprite.
  386.     Restore the original window in the process structure.
  387.     Close Oberon window and screen.
  388.     Free Chip-Mem-Pool.
  389.     Close Timer Device
  390.     proc:ProcessPtr;
  391.     scr:ScreenPtr;
  392.     win:WindowPtr;
  393.     i: INTEGER;
  394. BEGIN
  395.     IF pointerData#0 THEN
  396.         I.ClearPointer(window);
  397.         IF E.execVersion<39 THEN E.FreeMem(pointerData,pointerSize) END;
  398.         pointerData:=0
  399.     END;
  400.     IF oldProcessWindow#0 THEN
  401.         proc:=SYSTEM.VAL(ProcessPtr,E.FindTask(0));
  402.         proc.windowPtr:=oldProcessWindow;
  403.         oldProcessWindow:=0
  404.     END;
  405.     win := SYSTEM.VAL(WindowPtr, window); scr := SYSTEM.VAL(ScreenPtr, screen);
  406.     IF PensObtained THEN
  407.         FOR i:=0 TO SHORT(ASH(1, OberonDepth))-1 DO
  408.             G.ReleasePen(scr.viewPort.colorMap, i+ColorOffset)
  409.         END;
  410.     END;
  411.     IF win#NIL THEN I.CloseWindow(window); win := NIL END;
  412.     IF scr#NIL THEN I.CloseScreen(screen); scr := NIL END;
  413.     window := SYSTEM.VAL(LONGINT, win); screen := SYSTEM.VAL(LONGINT, scr);
  414.     IF ChipMemPool#0 THEN E.DeletePool(ChipMemPool) END;
  415.     IF TimerOpen THEN CloseTimerDevice() END
  416. END Close;
  417. PROCEDURE GetDefaultMode(VAR info:Info; VAR fromEnv:BOOLEAN);
  418.     Initialise info with the values from the environment. If this is not
  419.     possible, use the default sizes, and the screen mode of the workbench
  420.     screen (if available). fromEnv returns FALSE, if the environment wasn't
  421.     found.
  422.     key:LONGINT;
  423.     len:LONGINT;
  424.     scr:ScreenPtr;
  425.     DosV36: BOOLEAN;
  426. BEGIN
  427.     DosV36:=D.dosVersion<=37; (* docu said 36, but testing said 37 *)
  428.     len:=D.GetVar(envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.binaryVar,D.dontNullTerm});
  429.     fromEnv:=((DosV36 & (len=SIZE(Info)-1)) OR ((~DosV36) & (len=SIZE(Info)))) & (info.version=infoVersion);
  430.     IF ~fromEnv THEN
  431.         scr:=SYSTEM.VAL(ScreenPtr,I.LockPubScreen(0));
  432.         IF scr#NIL THEN
  433.             key:=G.GetVPModeID(SYSTEM.ADR(scr.viewPort));
  434.             I.UnlockPubScreen(0,SYSTEM.VAL(I.ScreenPtr,scr))
  435.         ELSE
  436.             key:=G.hiresLaceKey
  437.         END;
  438.         info.version:=infoVersion;
  439.         info.displayID:=key;
  440.         info.width:=defaultWidth;
  441.         info.height:=defaultHeight;
  442.         info.depth:=defaultDepth;
  443.         info.oscan:=I.oScanText;
  444.         info.autoScroll:=TRUE;
  445.         info.useWBWindow:=FALSE;
  446.         info.modifyColors:=FALSE;
  447. END GetDefaultMode;
  448. PROCEDURE ReadScreenMode*(VAR displayID:LONGINT;
  449.         VAR height, width, depth: INTEGER; VAR oscan:LONGINT; VAR autoScroll, WBWindow, PrivateColors: BOOLEAN);
  450.     Read the environment variable, and extract from it all values
  451.     needed for screen initialization. Use the default values, if the
  452.     environment variable doesn't exist, or has a wrong version.
  453.     dummy:BOOLEAN;
  454.     info:Info;
  455. BEGIN
  456.     GetDefaultMode(info,dummy);
  457.     displayID:=info.displayID;
  458.     width:=info.width;
  459.     height:=info.height;
  460.     depth:=info.depth;
  461.     oscan:=info.oscan;
  462.     autoScroll:=info.autoScroll;
  463.     WBWindow:=info.useWBWindow;
  464.     PrivateColors:=info.modifyColors;
  465. END ReadScreenMode;
  466. PROCEDURE WriteScreenMode*(displayID:LONGINT;
  467.         height, width, depth: INTEGER; oscan:LONGINT; autoScroll, useWBWindow, modifyColors:BOOLEAN);
  468.     Store the screen values into the environment variable. On pre 3.0 Amigas
  469.     write them also to the envarc: files as SetVar won't do it for you.
  470.     dummy:LONGINT;
  471.     dummyB:BOOLEAN;
  472.     f:D.FileHandlePtr;
  473.     info:Info;
  474. BEGIN
  475.     info.version:=infoVersion;
  476.     info.displayID:=displayID;
  477.     info.width:=width;
  478.     info.height:=height;
  479.     info.depth:=depth;
  480.     info.oscan:=oscan;
  481.     info.autoScroll:=autoScroll;
  482.     info.useWBWindow:=useWBWindow;
  483.     info.modifyColors:=modifyColors;
  484.     dummyB:=D.SetVar(
  485.         envName,SYSTEM.ADR(info),SIZE(Info),{D.globalOnly,D.saveVar,D.binaryVar,D.dontNullTerm}
  486.     IF A.aslVersion<39 THEN
  487.         f:=D.Open(envarcName,D.readWrite);
  488.         IF f#0 THEN
  489.             dummy:=D.Write(f,info,SIZE(Info));
  490.             dummyB:=D.Close(f)
  491.         END
  492. END WriteScreenMode;
  493. PROCEDURE ChangeMode2(info:Info);
  494.     Present a screen mode requester prefilled with the values from info.
  495.     Store the returned values into the environment.
  496.     ScreenModeRequesterPtr=POINTER TO A.ScreenModeRequester;
  497.     ok, useWBWindow, modifyColors: BOOLEAN;
  498.     screenRequest:ScreenModeRequesterPtr;
  499.     tags:ARRAY 15 OF U.TagItem;
  500. BEGIN
  501.     IF ~WBWindow THEN I.ClearPointer(window) END;
  502.     tags[0].tag:=A.tsmDoAutoScroll;
  503.     tags[0].data:=SYSTEM.VAL(LONGINT,TRUE);
  504.     tags[1].tag:=A.tsmDoDepth;
  505.     tags[1].data:=SYSTEM.VAL(LONGINT,TRUE);
  506.     tags[2].tag:=A.tsmDoHeight;
  507.     tags[2].data:=SYSTEM.VAL(LONGINT,TRUE);
  508.     tags[3].tag:=A.tsmDoOverscanType;
  509.     tags[3].data:=SYSTEM.VAL(LONGINT,TRUE);
  510.     tags[4].tag:=A.tsmDoWidth;
  511.     tags[4].data:=SYSTEM.VAL(LONGINT,TRUE);
  512.     tags[5].tag:=A.tsmInitialAutoScroll;
  513.     IF info.autoScroll THEN
  514.         tags[5].data:=-1
  515.     ELSE
  516.         tags[5].data:=0
  517.     END;
  518.     tags[6].tag:=A.tsmInitialDisplayDepth;
  519.     tags[6].data:=info.depth;
  520.     tags[7].tag:=A.tsmInitialDisplayHeight;
  521.     tags[7].data:=info.height;
  522.     tags[8].tag:=A.tsmInitialDisplayID;
  523.     tags[8].data:=info.displayID;
  524.     tags[9].tag:=A.tsmInitialDisplayWidth;
  525.     tags[9].data:=info.width;
  526.     tags[10].tag:=A.tsmInitialOverscanType;
  527.     tags[10].data:=info.oscan;
  528.     tags[11].tag:=A.tsmScreen;
  529.     tags[11].data:=screen;
  530.     tags[12].tag:=A.tsmMaxDepth;
  531.     tags[12].data:=maxDepth;
  532.     tags[13].tag:=U.done;
  533.     screenRequest:=SYSTEM.VAL(ScreenModeRequesterPtr,A.AllocAslRequest(A.aslScreenModeRequest,tags));
  534.     Assert(screenRequest#NIL,"No ScreenModeRequester");
  535.     tags[0].tag:=U.done;
  536.     ok:=A.AslRequest(SYSTEM.VAL(LONGINT,screenRequest),tags);
  537.     IF ok THEN
  538.         useWBWindow:=
  539.             I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga", "Use Custom Screen ?","Yes|No")=0;
  540.         modifyColors:=FALSE;
  541.         IF useWBWindow THEN
  542.             modifyColors:=I.CallEasyRequest(window, {}, "Oberon System V4 for Amiga",
  543.                 "Modify Default Colors If Necessary ?", "Yes|No")#0;
  544.         END;
  545.         WriteScreenMode(
  546.             screenRequest.displayID,SHORT(screenRequest.displayHeight),SHORT(screenRequest.displayWidth)
  547.             ,screenRequest.displayDepth,screenRequest.overscanType,screenRequest.autoScroll#0
  548.             ,useWBWindow, modifyColors
  549.     END;
  550.     A.FreeAslRequest(SYSTEM.VAL(LONGINT,screenRequest));
  551.     screenRequest:=NIL;
  552.     IF ~WBWindow THEN I.SetPointer(window,pointerData,2,16,0,0) END
  553. END ChangeMode2;
  554. PROCEDURE ChangeMode*(VAR res:INTEGER);
  555.     Present screen mode requester if the OS version
  556.     supports it. Used by System.ChangeMode.
  557.     dummy:BOOLEAN;
  558.     info:Info;
  559. BEGIN
  560.     IF A.aslVersion>=38 THEN
  561.         GetDefaultMode(info,dummy);
  562.         ChangeMode2(info);
  563.         res:=0
  564.     ELSE
  565.         res:=1
  566. END ChangeMode;
  567. PROCEDURE DosCmd*(cmd, outName:ARRAY OF CHAR; VAR res:INTEGER);
  568.     Run a program with STDIN set to NIL: and STDOUT set to output.
  569.     in,out:D.FileHandlePtr;
  570.     tags:ARRAY 4 OF U.TagItem;
  571. BEGIN
  572.     in:=D.Open("NIL:",D.oldFile);
  573.     ASSERT(in#0);
  574.     out:=D.Open(outName,D.newFile);
  575.     ASSERT(out#0);
  576.     tags[0].tag:=D.sysInput;
  577.     tags[0].data:=in;
  578.     tags[1].tag:=D.sysOutput;
  579.     tags[1].data:=out;
  580.     tags[2].tag:=D.npCloseOutput;
  581.     tags[2].data:=SYSTEM.VAL(LONGINT,FALSE);
  582.     tags[3].tag:=U.done;
  583.     res:=SHORT(D.System(cmd,tags));
  584.     IF D.Close(out) THEN END;
  585.     IF D.Close(in) THEN END
  586. END DosCmd;
  587. PROCEDURE SwapBits*(b: SYSTEM.BYTE):SYSTEM.BYTE;
  588.     Swaps the bits within a byte [76543210] -> [01234567]
  589.     i:INTEGER;
  590.     in,res:LONGINT;
  591. BEGIN
  592.     res:=0;
  593.     in:=ORD(SYSTEM.VAL(CHAR,b));
  594.     FOR i:=0 TO 7 DO
  595.         res:=res*2+in MOD 2;
  596.         in:=in DIV 2
  597.     END;
  598.     RETURN CHR(res)
  599. END SwapBits;
  600. PROCEDURE ConvertAnsiToOberon*(VAR buf:ARRAY OF CHAR; len:LONGINT);
  601.     Convert ANSI (ISO latin1) Codes to the Oberon font. This conversion
  602.     can be switched off by setting dontConvert:=TRUE.
  603.     i:LONGINT;
  604. BEGIN
  605.     IF dontConvert THEN RETURN END;
  606.     FOR i:=0 TO len-1 DO
  607.         buf[i]:=AtoO[ORD(buf[i])]
  608. END ConvertAnsiToOberon;
  609. PROCEDURE Loop*;
  610.     This is the loop, which the loader calls instead of Oberon.Loop.
  611.     It remembers the current stack pointer before calling Oberon.Loop,
  612.     so the trap handler can return us into the loop, and we can restart
  613.     Oberon.Loop after each trap.
  614.     imported:ARRAY 32 OF CHAR;
  615.     mod,modules:Module;
  616.     oberonLoop:PROCEDURE;
  617.     res:INTEGER;
  618. BEGIN
  619.     ThisMod("Oberon",mod,res,modules,imported);
  620.     Assert(res=0,"Amiga.Loop: Oberon not found");
  621.     ThisCommand(mod,"Loop",SYSTEM.VAL(Absolute,oberonLoop),res);
  622.     Assert(res=0,"Amiga.Loop: Oberon.Loop not found");
  623.     LOOP
  624.         SaveRegs;
  625.         SYSTEM.GETREG(15,stackPtr);
  626.         DEC(stackPtr,4); (* stack pointer value after call of oberonLoop. *)
  627.         oberonLoop;
  628.         LoadRegs
  629. END Loop;
  630. PROCEDURE ConvAtoO*(ch: CHAR): CHAR;    (*<<RD*)
  631.     Convert Char Amiga->Oberon
  632. BEGIN
  633.     IF dontConvert THEN
  634.         RETURN ch
  635.     ELSE
  636.         RETURN AtoO[ORD(ch)]
  637. END ConvAtoO;
  638. PROCEDURE ConvOtoA*(ch: CHAR): CHAR;    (*<<RD*)
  639.     Convert Char Oberon->Amiga
  640. BEGIN
  641.     IF dontConvert THEN
  642.         RETURN ch
  643.     ELSE
  644.         RETURN OtoA[ORD(ch)]
  645. END ConvOtoA;
  646. PROCEDURE InitCharConv;    (*<<RD*)
  647.     Init Arrays for Character Conversion
  648. VAR i: INTEGER;
  649. BEGIN
  650.     (* no conversion for Ascii *)
  651.     FOR i:=0 TO 127 DO
  652.         AtoO[i]:=CHR(i); OtoA[i]:=CHR(i)
  653.     END;
  654.     (* Amiga to Oberon *)
  655.     AtoO[00AH]:=00DX;    AtoO[01CH]:=" ";    AtoO[0B4H]:="'";
  656.     AtoO[0C4H]:="
  657. ";    AtoO[0D6H]:="
  658. ";    AtoO[0DCH]:="
  659. ";    AtoO[0E4H]:="
  660.     AtoO[0EBH]:="
  661. ";    AtoO[0EFH]:="
  662. ";    AtoO[0F6H]:="
  663. ";    AtoO[0FCH]:="
  664.     AtoO[0E2H]:="
  665. ";    AtoO[0EAH]:="
  666. ";    AtoO[0EEH]:="
  667. ";    AtoO[0F4H]:="
  668.     AtoO[0FBH]:="
  669. ";    AtoO[0E0H]:="
  670. ";    AtoO[0E8H]:="
  671. ";    AtoO[0ECH]:="
  672.     AtoO[0F2H]:="
  673. ";    AtoO[0F9H]:="
  674. ";    AtoO[0E1H]:="
  675. ";    AtoO[0E9H]:="
  676.     AtoO[0E7H]:="
  677. ";    AtoO[0F1H]:="
  678. ";    AtoO[0DFH]:="
  679.     (* Oberon to Amiga*)
  680.     OtoA[00DH]:=00AX;    OtoA[01CH]:=000X;
  681.     OtoA[ORD("
  682. ")]:=0C4X;    OtoA[ORD("
  683. ")]:=0D6X;    OtoA[ORD("
  684. ")]:=0DCX;    OtoA[ORD("
  685. ")]:=0E4X;
  686.     OtoA[ORD("
  687. ")]:=0EBX;    OtoA[ORD("
  688. ")]:=0EFX;    OtoA[ORD("
  689. ")]:=0F6X;    OtoA[ORD("
  690. ")]:=0FCX;
  691.     OtoA[ORD("
  692. ")]:=0E2X;    OtoA[ORD("
  693. ")]:=0EAX;    OtoA[ORD("
  694. ")]:=0EEX;    OtoA[ORD("
  695. ")]:=0F4X;
  696.     OtoA[ORD("
  697. ")]:=0FBX;    OtoA[ORD("
  698. ")]:=0E0X;    OtoA[ORD("
  699. ")]:=0E8X;    OtoA[ORD("
  700. ")]:=0ECX;
  701.     OtoA[ORD("
  702. ")]:=0F2X;    OtoA[ORD("
  703. ")]:=0F9X;    OtoA[ORD("
  704. ")]:=0E1X;    OtoA[ORD("
  705. ")]:=0E9X;
  706.     OtoA[ORD("
  707. ")]:=0E7X;    OtoA[ORD("
  708. ")]:=0F1X;    OtoA[ORD("
  709. ")]:=0DFX;
  710. END InitCharConv;
  711. PROCEDURE Init;
  712.     Get the screen infos and initialize the Oberon screen and window.
  713.     Install a blank sprite as pointer. Install the termination procedure for
  714.     all this.
  715.     Initialise the gloabl variables for character conversion and middle
  716.     mouse button replacement.
  717.     fromEnv:BOOLEAN;
  718.     info:Info;
  719.     proc:ProcessPtr;
  720.     scr:ScreenPtr;
  721.     scrrp:RPPtr;
  722.     tags:ARRAY 13 OF U.TagItem;
  723.     win:WindowPtr;
  724.     bm: BitmapPtr;
  725.     i: INTEGER;
  726.     PROCEDURE OpenScreen();
  727.     BEGIN
  728.         Depth:=info.depth; OberonDepth:=Depth;
  729.         Height:=info.height;
  730.         Width:=(info.width DIV 8)*8;
  731.         tags[0].tag:=I.saDepth;
  732.         tags[0].data:=info.depth;
  733.         tags[1].tag:=I.saHeight;
  734.         tags[1].data:=Height;
  735.         tags[2].tag:=I.saWidth;
  736.         tags[2].data:=Width;
  737.         tags[3].tag:=I.saDisplayID;
  738.         tags[3].data:=info.displayID;
  739.         tags[4].tag:=I.saQuiet;
  740.         tags[4].data:=-1;
  741.         tags[5].tag:=I.saAutoScroll;
  742.         tags[5].data:=-1;
  743.         tags[6].tag:=I.saOverscan;
  744.         tags[6].data:=info.oscan;
  745.         tags[7].tag:=I.saBehind;
  746.         tags[7].data:=-1;
  747.         tags[8].tag:=I.saDetailPen;
  748.         tags[8].data:=0;
  749.         tags[9].tag:=I.saBlockPen;
  750.         tags[9].data:=SYSTEM.LSH(1,Depth)-1;
  751.         tags[10].tag:=I.saTitle;
  752.         tags[10].data:=SYSTEM.ADR(screenTitle);
  753.         tags[11].tag:=I.saInterleaved;
  754.         tags[11].data:=-1;
  755.         tags[11].tag:=U.done;
  756.         screen:=I.OpenScreenTags(0(*NIL*),tags); scr := SYSTEM.VAL(ScreenPtr, screen);
  757.         Assert(scr#NIL,"No screen");
  758.         tags[0].tag:=I.waCustomScreen;
  759.         tags[0].data:= screen;
  760.         tags[1].tag:=I.waIDCMP;
  761.         tags[1].data:=SYSTEM.VAL(LONGINT, {I.rawKey,I.mouseButtons(*,I.mouseMove*)});
  762.         tags[2].tag:=I.waFlags;
  763.         tags[2].data:=SYSTEM.VAL(LONGINT, {I.backDrop,I.borderless,I.activate,I.rmbTrap,I.noCareRefresh});
  764.         tags[3].tag:=U.done;
  765.         window:=I.OpenWindowTags(0(*NIL*),tags); win := SYSTEM.VAL(WindowPtr, window);
  766.         Assert(win#NIL,"No window");
  767.         I.ShowTitle(screen,FALSE);
  768.         I.ScreenToFront(screen);
  769.         ModifyColors:=TRUE
  770.     END OpenScreen;
  771.     PROCEDURE OpenWBWindow();
  772.         VAR image: ARRAY 16 OF SET; i, OberonCols, AmigaCols: INTEGER;
  773.         PROCEDURE FindColors(): BOOLEAN;
  774.             VAR i, j: INTEGER;
  775.         BEGIN
  776.             i:=0;
  777.             WHILE i<AmigaCols DO
  778.                 j:=0;
  779.                 WHILE G.ObtainPen(scr.viewPort.colorMap, i+j, 0, 0, 0, {G.penbExclusive, G.penbNoSetcolor})#-1 DO
  780.                     INC(j);
  781.                     IF j=OberonCols THEN
  782.                         ColorOffset:=i;
  783.                         PensObtained:=TRUE;
  784.                         ModifyColors:=TRUE;
  785.                         RETURN TRUE;
  786.                     END;
  787.                 END;
  788.                 WHILE j#0 DO
  789.                     DEC(j);
  790.                     G.ReleasePen(scr.viewPort.colorMap, i+j);
  791.                 END;
  792.                 INC(i, OberonCols)
  793.             END;
  794.             RETURN FALSE
  795.         END FindColors;
  796.     BEGIN
  797.         screen:=I.LockPubScreen(0);
  798.         scr:=SYSTEM.VAL(ScreenPtr, screen);
  799.         Assert(scr#NIL,"No screen");
  800.         scrrp:=SYSTEM.VAL(RPPtr, SYSTEM.ADR(scr.rastPort));
  801.         bm:=SYSTEM.VAL(BitmapPtr, scrrp.bitMap);
  802.         AmigaCols:=SHORT(ASH(1, bm.depth));
  803.         OberonCols:=SHORT(ASH(1, info.depth));
  804.         IF (E.execVersion<39) OR (~FindColors()) THEN
  805.             IF ModifyColors & (OberonCols<AmigaCols) THEN
  806.                 ColorOffset:=AmigaCols DIV 2;
  807.             END;
  808.         END;
  809.         tags[0].tag:=I.waIDCMP;
  810.         tags[0].data:=SYSTEM.VAL(LONGINT, {I.closeWindow, I.rawKey,I.mouseButtons(*,I.mouseMove*)});
  811.         tags[1].tag:=I.waFlags;
  812.         tags[1].data:=SYSTEM.VAL(LONGINT, {I.windowClose, I.windowDrag, I.windowDepth,I.rmbTrap,I.noCareRefresh});
  813.         tags[2].tag:=I.waInnerWidth;
  814.         tags[2].data:=(info.width DIV 8)* 8;
  815.         tags[3].tag:=I.waInnerHeight;
  816.         tags[3].data:=info.height;
  817.         tags[4].tag:=I.waTitle;
  818.         tags[4].data:=SYSTEM.ADR(screenTitle);
  819.         tags[5].tag:=I.waScreenTitle;
  820.         tags[5].data:=SYSTEM.ADR(screenTitle);
  821.         tags[6].tag:=I.waAutoAdjust;
  822.         tags[6].data:=1;
  823.         tags[7].tag:=I.waPubScreen;
  824.         tags[7].data:=screen;
  825.         tags[8].tag:=U.done;
  826.         window:=I.OpenWindowTags(0(*NIL*),tags); win := SYSTEM.VAL(WindowPtr, window);
  827.         Assert(win#NIL,"No window");
  828.         I.UnlockPubScreen(0, screen);
  829.         Height:=win.height-win.borderTop-win.borderBottom;
  830.         Width:=((win.width-win.borderLeft-win.borderRight)DIV 8)*8;
  831.         image[14] := {13};    (* Create Pointer *)
  832.         image[13] := {12..14};
  833.         image[12] := {11..13};
  834.         image[11] := {10..12};
  835.         image[10] := {9..11};
  836.         image[9] := {8..10};
  837.         image[8] := {7..9};
  838.         image[7] := {0, 6..8};
  839.         image[6] := {0, 1, 5..7};
  840.         image[5] := {0..2, 4..6};
  841.         image[4] := {0..5};
  842.         image[3] := {0..4};
  843.         image[2] := {0..5};
  844.         image[1] := {0..6};
  845.         image[0] := {0..7};
  846.         FOR i:=0 TO 14 DO
  847.             SYSTEM.PUT(pointerData+4*i+2, SwapBits(CHR(SYSTEM.VAL(LONGINT, image[i]) MOD 256)));
  848.             SYSTEM.PUT(pointerData+4*i+3, SwapBits(CHR(ASH(SYSTEM.VAL(LONGINT, image[i]), -8))));
  849.             SYSTEM.PUT(pointerData+4*i, CHR(0));
  850.             SYSTEM.PUT(pointerData+4*i+1, CHR(0));
  851.         END;
  852.     END OpenWBWindow;
  853. BEGIN
  854.     ColorOffset:=0; PensObtained:=FALSE;
  855.     IF E.execVersion>=39 THEN
  856.         ChipMemPool:=E.CreatePool({E.memChip}, PoolPuddleSize, PoolThreshSize);
  857.         Assert(ChipMemPool#0, "Can not create memory pool for fonts")
  858.     ELSE
  859.         ChipMemPool:=0
  860.     END;
  861.     IF ChipMemPool#0 THEN
  862.         pointerData:=E.AllocPooled(ChipMemPool, pointerSize);
  863.         FOR i:=0 TO pointerSize-1 DO SYSTEM.PUT(pointerData+i, CHR(0)) END
  864.     ELSE
  865.         pointerData:=E.AllocMem(pointerSize,{E.memChip,E.memClear})
  866.     END;
  867.     version:=screenTitle;
  868.     IF A.aslVersion>=38 THEN
  869.         GetDefaultMode(info,fromEnv);
  870.         IF ~fromEnv THEN
  871.             ChangeMode2(info);
  872.             GetDefaultMode(info,fromEnv)
  873.         END
  874.     ELSE
  875.         GetDefaultMode(info,fromEnv)
  876.     END;
  877.     WBWindow:=info.useWBWindow; ModifyColors:=info.modifyColors;
  878.     IF WBWindow THEN OpenWBWindow() ELSE OpenScreen() END;
  879.     proc:=SYSTEM.VAL(ProcessPtr,E.FindTask(0));
  880.     oldProcessWindow:=proc.windowPtr;
  881.     proc.windowPtr:=window;
  882.     I.SetPointer(window,pointerData,15,16,0,0);
  883.     I.ActivateWindow(window);
  884.     scrrp:=SYSTEM.VAL(RPPtr, SYSTEM.ADR(scr.rastPort));
  885.     bm:=SYSTEM.VAL(BitmapPtr, scrrp.bitMap);
  886.     Depth:=bm.depth;
  887.     IF info.depth<=Depth THEN OberonDepth:=info.depth ELSE OberonDepth:=Depth END;
  888.     TermProcedure(Close);
  889.     dontConvert:=FALSE;
  890.     useLAltAsMouse:=TRUE;
  891.     idlePri:=-128;
  892.     normalPri:=0;
  893.     OpenTimerDevice();
  894.     TicsToWait:=20000;
  895.     MainLoopType:=TimerOpen; (* Use AmigaLoop if Timer Device is open *)
  896.     PrinterName:="PrinterOut.ps";
  897.     PictPrintThresh:=128;
  898.     UseQuitRequester:=FALSE;
  899.     InitCharConv
  900. END Init;
  901. BEGIN
  902.     TimerOpen:=FALSE; TimerMP:=0; TimerIOPtr:=0;
  903.     stackPtr:=0;
  904.         Ensure, that OLoad probably guessed right, when patching in loaderCall.
  905.     Assert((guard1=002468ACEH) & (guard2=013579BDFH),"Amiga: wrong loader call guards.");
  906.     Init
  907. END Amiga.
  908.